home *** CD-ROM | disk | FTP | other *** search
/ CD Ware Multimedia 1994 November / Cd Ware (Nro. 2) - Epimundo.iso / DOS / PG / MANIP.ZIP / MANIPTXT.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1994-04-06  |  4.7 KB  |  126 lines
  1. program ManipTxt;
  2. {********************************************************************}
  3. { This program demonstrates some functions that manipulate strings.  }
  4. { The program was created to manipulate 'G' code files that are      }
  5. { created for CNC machines.  CNC = Computer Numerical Control.       }
  6. {                                                                    }
  7. { These 'G' code files are text files on a computer or CNC that      }
  8. { control the axis movements of the machine.                         }
  9. {                                                                    }
  10. { Some people like to have spaces between the 'Words' of a 'G' coded }
  11. { file in order to conserve disk space while others use a space      }
  12. { between the words for better reading ability.                      }
  13. {                                                                    }
  14. { This program has the ability to insert a space between each letter }
  15. { and number of a text file under certain conditions.  The string    }
  16. { must not start with a '(' or a ':' or a '%'.  If the string does   }
  17. { start with these characters then they will be written to the       }
  18. { destination file as is.  The same conditions hold true if the user }
  19. { decides to remove spaces from a file.                              }
  20. {                                                                    }
  21. { This code could have been shortened and functions could have been  }
  22. { put together but to show the seperate functions was a better idea  }
  23. { for clarity sake.                                                  }
  24. {                                                                    }
  25. { Author         : Allan J. Bremer    (Mr. Machinist Program)        }
  26. { Compuserve id  : 73113,2206                                        }
  27. {********************************************************************}
  28.  
  29. Uses Crt;
  30. var
  31.    Line_Current                      : String;
  32.    Source_File,Dest_File             : Text;
  33.    Source, Dest                      : String;
  34.    SourceOpened,DestExist            : Boolean;
  35.    Spaces                            : Char;
  36.    Skip                              : Boolean;
  37.  
  38. procedure OpenFiles;  { Does all the File init stuff }
  39. begin
  40.        SourceOpened := True;
  41.        DestExist := False;
  42.        Assign(Source_File,Source);
  43.        {$I-} Reset(Source_File); {$I+}
  44.        if (IOResult = 0) then
  45.          Begin
  46.            Assign(Dest_File,Dest);
  47.            {$I-} ReWrite(Dest_File); {$I+}
  48.            if (IOResult <> 0) Then Rewrite(Dest_File);
  49.          end else
  50.          begin
  51.            ClrScr;
  52.            Writeln('Unable to open source file, may not exist!');
  53.            Halt;
  54.          end
  55. end;
  56.  
  57. function IsAlpha(Ch: Char): Boolean;  { Checks for letters in string }
  58. begin
  59.   if (Ch in ['A'..'z']) then
  60.     IsAlpha := True
  61.   else
  62.     IsAlpha := False;
  63. end;
  64.  
  65. function IsSpace(Ch: Char): Boolean;  { Checks for spaces in string }
  66. begin
  67.   if (Ch in [' ']) then
  68.     IsSpace := True
  69.   else
  70.     IsSpace := False;
  71. end;
  72.  
  73. function SpaceBeforeChars(S: String): String;  { Puts in a space between }
  74. var i  : Integer;                              { letters and numbers or  }
  75. begin                                          { takes all spaces out of }
  76.   i := 1;                                      { a string.               }
  77.   if Spaces = 'y' then
  78.   begin
  79.     repeat
  80.       if (IsAlpha(S[i]))and(i<>1) then
  81.       begin
  82.         Insert(' ',S,i);
  83.         Inc(i);
  84.       end;
  85.       Inc(i);
  86.     until i > Length(S);
  87.     SpaceBeforeChars := S;
  88.   end else
  89.   begin
  90.     repeat
  91.       if (IsSpace(S[i])) and (i<>1) then
  92.       begin
  93.         Delete(S,i,1);
  94.         Inc(i);
  95.       end;
  96.       Inc(i);
  97.     until i > Length(S);
  98.     SpaceBeforeChars := S;
  99.   end;
  100. end;
  101.  
  102. begin
  103.   ClrScr;
  104.   Write('Source File  : '); Readln(Source);  { Get source file name         }
  105.   Writeln;
  106.   Write('Destination  : '); Readln(Dest);    { Get destination file name    }
  107.   Writeln;
  108.   Write('Spaces? (y/n): '); Readln(Spaces);  { Small letter 'y' means put   }
  109.   Writeln;                                   { spaces between letters and   }
  110.   OpenFiles;                                 { numbers, anything else means }
  111.   Skip := False;                             { remove all spaces in string. }
  112.   If (SourceOpened) and (DestExist = False) Then
  113.     Begin
  114.       Repeat
  115.         Readln(Source_File,Line_Current);
  116.         if(Pos('(',Line_Current)=1)or(Pos(':',Line_Current)=1)or
  117.         (Pos('%',Line_Current)=1) then Skip:=True;
  118.         if not Skip then Line_Current := SpaceBeforeChars(Line_Current);
  119.         Writeln(Dest_File,Line_Current);
  120.         Skip := False;
  121.       Until Eof(Source_File);
  122.       Close(Source_File);
  123.       Close(Dest_File);
  124.     end;
  125. end.
  126.